COMMENT ⊗   VALID 00009 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00002 00002	TITLE BIGNUM ARITHMETIC
 00003 00003	PAGE
 00004 00004	PAGEINITIALIZE THE BIGNUM SYSTEM BY CHANGING MAGIC LOCATIONS IN LISP
 00005 00005	PAGE
 00012 00006		MOVE B,A
 00022 00007		CAIE T,POSNUM
 00031 00008		ADD B,GC
 00034 00009	
 00035 ENDMK
⊗;
TITLE BIGNUM ARITHMETIC

;AC DEFINITIONS
NIL=0
A=1
B=2
C=3
T=6
TT=7
T10=10
FF=16
AR1=4
F=15
P=14
D=12
S=11
AR2A=5
R=13
SP=17

INUMIN=377777
INUM0=577777
SIGN=400000
MINSGN==10

INTERNAL BIGINI

EXTERNAL CONS,FWCONS,ACONS,NCONS,XCONS,VBASE,VNOPOINT,LAST,NUMVAL
EXTERNAL POSNUM,NEGNUM,NUM1,CTY,EVBIG,REVERSE,BPR
EXTERNAL TRUE,FALSE,NUMV2,FIXNUM,FLONUM,FIX1A,LENGTH,MINUSP
EXTERNAL BPR,NUM3,EVBIG,NUMV4,OPOV,NUMV3,NUMBP2,FIX2,OPR,FLOOV
PAGE
;POWER OF TEN
PWR10:	MOVEM B,BASEX#
	MOVE C,B
	IMUL B,B	;BASE↑2
	IMUL B,B	;BASE↑4
	IMUL B,C	;BASE↑5
	IMUL B,B	;BASE↑TEN
	MOVEM B,BASE10#
	POPJ P,

B0CONS:	MOVEI A,0
BNCONS:	MOVEI B,0
BCONS:	PUSHJ P,FWCONS
	JRST CONS

QCONS=ACONS-1
PAGE;INITIALIZE THE BIGNUM SYSTEM BY CHANGING MAGIC LOCATIONS IN LISP
BIGINI:	MOVE A,[JRST BPRINT]
	MOVEM A,BPR		;PRINT
	HRRI A,BIGEV	
	MOVEM A,EVBIG		;EVAL
	HRRI A,NUMVB
	MOVEM A,NUMV4		;NUMVAL
	HRRI A,BIGDIS	
	MOVEM A,NUMV3		;BIGNUM OPS
	HRRI A,BIGNP
	MOVEM A,NUMBP2		;NUMBERP
	HRRI A,RDBNM
	HRRM A,NUM3		;READ
	HRRI A,FIXOVL
	HRRM A,OPOV		;OVERFLOW
	HRRI A,BFIX
	HRRM A,FIX2		;FIX
	JRST FALSE
PAGE
;BIGNUM PRINT
;BPR IN LISP IS JRST BPRINT
BPRINT:	CAIN B,POSNUM
	JRST BPRIN2
	CAIE B,NEGNUM
	JRST BPR+1
	XCT "-",CTY
BPRIN2:	PUSHJ P,COPY
	PUSHJ P,BPRI
	POPJ P,

BPRI:	MOVE B,VBASE
	SUBI B,INUM0
	PUSHJ P,PWR10
	PUSHJ P,BPRJ
	SKIPE A,VNOPOINT
	POPJ P,
	MOVE A,BASEX
	CAIE A,12
	POPJ P,
	MOVEI A,"."
	JRST (R)	;PARTICULAR TYO

BPRJ:	MOVE B,BASE10
	PUSHJ P,Q1
	JUMPE B,BPR2	;ZERO QUOTIENT
	PUSH P,A	;REMAINDER
	MOVE A,B	;QUOTIENT
	PUSHJ P,BPRJ
	POP P,A		;REMAINDER

BPR1:	MOVEI C,12	;PRINT TEN DIGITS
	SOJL C,CPOPJ
	IDIV A,BASEX
	HRLM B,(P)
	PUSHJ P,BPR1+1
	JRST FP7A1	;PARTICULAR TYO FOR DIGIT

;IGNORE LEADING ZERO DIGITS FOR FIRST WORD
BPR2:	JUMPE A,CPOPJ
	IDIV A,BASEX
	HRLM B,(P)
	PUSHJ P,BPR2
FP7A1:	HLRE A,(P)
	ADDI A,"0"
	JRST (R)	;PARTICULAR TYO FOR DIGIT

PAGE
;DIVIDES BIGNUM IN A BY INTEGER IN B
;DESTROYS ORIGINAL BIGNUM
;RETURNS REMAINDER IN A, QUOTIENT IN B
Q1:	MOVEM B,Y#
	PUSH P,A
	HRRZ A,(A)
	JUMPE A,Q1A
	PUSHJ P,Q1+1
	POP P,C
	HRRM B,(C)
	HLRZ T,(C)
	MOVE B,(T)
	DIV A,Y
Q1B:	MOVEM A,(T)	;REPLACE OLD DIGIT
	MOVE A,B
	MOVE B,C
	POPJ P,

Q1A:	POP P,C
	HLRZ T,(C)
	MOVE A,(T)
	IDIV A,Y
	JUMPN A,Q1B	;NON-ZERO QUOTIENT - KEEP IT
	HRRZM FF,(T)	;RECLAIM FULL WORD
	MOVE FF,T
	HRRZM F,(C)	;RECLAIM FREE WORD
	HRRZ F,C
	MOVEI C,0
	JRST Q1B+1
PAGE
;BIGNUM READ
;NUM3 IN LISP HAS JFCL 10,RDBNM
RDBNM:	PUSH P,[NIL]	;INITIAL VALUE OF BIGNUM
	MOVSI C,700
	HRRI C,(SP)	;BYPE POINTER TO SPEC PDL
	MOVEM T,TSAV#
	MOVEM C,RDPTR#
	HRRZ B,NUM1	;BASE OF NUMBER
	PUSHJ P,PWR10

RDNM1:	MOVEI C,12	;TEN DIGITS AT A TIME
	MOVEI A,0
	ILDB B,RDPTR
	JUMPE B,RDNM2	;END OF BIGNUM
	IMUL A,BASEX
	ADDI A,-"0"(B)
	SOJG C,.-4
	MOVE B,BASE10
	PUSHJ P,RDSUB
	JRST RDNM1

RDNM2:	CAIN C,12	;NO DIGITS IN LAST SUPERDIGIT
	JRST RDNM3
	HRREI C,-12(C)	;NUMBER OF DIGITS IN LAST
	MOVEI B,1
	IMUL B,BASEX
	AOJL C,.-1	;COMPUTE BASEX↑(NUMBER OF DIGITS)
	PUSHJ P,RDSUB
RDNM3:	MOVEI B,POSNUM
	MOVE T,TSAV
	TLNE T,MINSGN	;SIGN OF BIGNUM
	MOVEI B,NEGNUM
	POP P,A
	SUB P,[XWD 1,1]
	JRST QCONS

RDSUB:	MOVE C,-1(P)
	PUSHJ P,BTIME1	;BIGNUM(C)*INT(B)+INT(A)
	MOVEM A,-1(P)
	POPJ P,
PAGE
BTIME0:	PUSH P,B
	PUSHJ P,COPY
	MOVE C,A
	POP P,B
	MOVEI A,0

;BIG(C)*INT(B)+INT(A) 
BTIME1:	JUMPE C,BNCONS	;END OF BIGNUM
	MOVEM B,MULR#	;MULTIPLIER
	PUSH P,C	;BIGNUM
BT1B:	MOVEM A,CARRY#
	MOVS T,(C)
	MOVE A,(T)
	MUL A,MULR
	ADD B,CARRY
	TLZE B,SIGN
	ADDI A,1
BT1E:	MOVEM B,(T)	;STORE LOW ORDER PRODUCT+CARRY IN BIGNUM
	HLRZS T		;(CDR BIGNUM)
	JUMPE T,BT1C	;END OF BIGNUM
	MOVE C,T
	JRST BT1B

BT1C:	JUMPE A,POPAJ	;NO HIGH ORDER PART 
	PUSHJ P,BNCONS	;CONSES FOR REMAINING HIGH ORDER PART
	HRRM A,(C)	;RPLACD END OF BIGNUM
POPAJ:	POP P,A
CPOPJ:	POPJ P,
PAGE
;BIGNUM COPY
COPY:	JUMPE A,CPOPJ
	HLRZ B,(A)
	PUSH P,(B)
	HRRZ A,(A)
	PUSHJ P,COPY
	MOVE B,A
	POP P,A
	JRST BCONS


;BIGNUM RECLAIM
RECLAIM:	
	CAILE A,INUMIN
	POPJ P,
	EXCH A,F
	EXCH A,(F)
	HRRZS A
	EXCH A,F
	EXCH A,(F)
	HLRZ B,A	;TYPE
	HRRZS A
	CAIE B,POSNUM
	CAIN B,NEGNUM
	JRST UNCONS
	POPJ P,

;BIGNUM UNCONS
UNCONS:
	JUMPE A,CPOPJ
	HLRZ B,(A)
	MOVEM FF,(B)
	MOVE FF,B
	EXCH A,F
	EXCH A,(F)
	HRRZS A
	JRST UNCONS

;EVBIG IN LISP HAS JRST BIGEV
BIGEV:	CAIE TT,POSNUM
	CAIN TT,NEGNUM
	POPJ P,
	HRRZ AR1,(AR1)
	JRST EVBIG+1
PAGE
;BIGNUM MINUSP
MINSP2:	CAIN B,POSNUM
	JRST FALSE
	JRST TRUE

;BIGNUM MINUS
MINS2:	CAIN B,POSNUM
	SKIPA B,[NEGNUM]
ABS2:	MOVEI B,POSNUM	;BIGNUM ABS
	JRST QCONS

;COMPARE TWO BIGNUMS A<B
BCMPR:	PUSHJ P,BDIF
	PUSH P,A
	PUSHJ P,MINUSP
	EXCH A,(P)
	PUSHJ P,RECLAIM
	JRST POPAJ

BEQUAL:	PUSHJ P,BDIF
	POP P,C
	CAIN A,INUM0
	JRST TRUE
	MOVE P,C
	PUSHJ P,RECLAIM
	JRST FALSE
PAGE
;DIFFERENCE OF TWO BIGNUMS
BDIF:	PUSHJ P,COMPSN	;COMPLEMENT SIGN OF BIGNUM IN B
;SUM OF TWO BIGNUMS
;BIGNUMS IN A AND B; SIGN(A) IN T, SIGN(B) IN TT
BPLUS:	PUSH P,B
	PUSHJ P,COPY
	EXCH A,(P)
	PUSHJ P,COPY
	POP P,C
	MOVE B,A
	MOVEI A,0
	CAME T,TT
	JRST BDIF1	;SIGNS DIFFERENT
	PUSH P,T	;SIGN OF RESULT
	PUSHJ P,BADD
	POP P,B
	JRST QCONS

BDIF1:	CAIN TT,POSNUM
	EXCH B,C
	PUSHJ P,BSUB	;POSNUM IN C, NEGNUM IN B
	JUMPL B,BDIF3
	PUSHJ P,SUPRSS
	MOVEI B,POSNUM
	JRST MAKBIG

BDIF3:	PUSHJ P,COMPLM
	MOVEI B,NEGNUM
	JRST MAKBIG

BSUB:	MOVNI TT,1
	MOVSI T,(SUB TT,(B))
	JRST BAS

BADD:	MOVEI TT,1
	MOVSI T,(ADD TT,(B))
PAGE
;CRY(A)(+ OR -) BIG(B) + BIG(C) → A, SIGN → B.
;DESTROYS BOTH BIGNUMS

BAS:	HRRM TT,BCRY
	PUSH P,B
BP2A:	HRRM B,BTMP
	MOVS B,(B)
	HLRZ TT,(C)
	EXCH TT,FF
	EXCH TT,(FF)	;RECLAIM FULL WORD
	EXCH C,F
	EXCH C,(F)	;RECLAIM FREE WORD
	ADD TT,A
	XCT T		;BIG(C) (+ OR -) BIG (B)
	MOVEI A,0
	TLZE TT,SIGN	;TURN OFF HIGH BIT
BCRY:	HRREI A,.	;SET CARRY IF OVERFLOW OR NEGATIVE
BP2B:	MOVEM TT,(B)
	HLRZS B
	HRRZS C
	JUMPE B,BP2F	;END OF B
	JUMPN C,BP2A
	JRST BP2D	;FINISH WITH CARRY (+ OR -) BIG(B)

BP2F:	JUMPE C,BP2H	;END OF C ALSO
	EXCH B,C
	HRRM B,@BTMP	;RPLACD END OF BIG(B) WITH REST OF C
	MOVSI T,(ADD TT,(B))	;FINISH WITH BIG(C) + CARRY
BP2D:	HRRM B,BTMP
	MOVS B,(B)
	MOVE TT,A
	XCT T		;CARRY (+ OR -) INTEGER
	JUMPL TT,BP2K
	MOVEM TT,(B)
	CAME T,[SUB TT,(B)]
	JRST POSXIT	;CAN QUIT NOW
	MOVEI A,0	;TURN OFF CARRY
	JRST BP2L	;CONTINUE TO NEGATE

BP2K:	HRRE A,BCRY
	TLZ TT,SIGN	;MAKE HIGH BIT ZERO
	MOVEM TT,(B)
BP2L:	HLRZS B
	JUMPN B,BP2D
BP2H:	JUMPLE A,XIT	;NO CARRY
	PUSHJ P,BNCONS
BTMP:	HRRM A,.	;RPLACD END OF BIGNUM WITH CARRY
POSXIT:	MOVEI B,0	;SIGN POSITIVE
	JRST POPAJ

XIT:	MOVE B,A	;SIGN IN B
	JRST POPAJ
PAGE
;SUPPRESS LEADING ZEROS FROM BIGNUM
SUPRSS:	SKIPA C,[JRST COMPL7]
;COMPLEMENT BIGNUM  (2↑35 COMPLEMENT)
COMPLM:	MOVSI C,(SUBM T,(B))
	JUMPE A,CPOPJ
	PUSH P,A
	HRLZI T,SIGN
	MOVEI TT,0
COMPL4:	MOVS B,(A)
	SKIPN (B)
	JUMPE TT,COMPL3
	XCT C
	HRLOI T,SIGN-1
COMPL7:	SKIPE (B)
	MOVEM A,TT
COMPL3:	HLRZ A,B
	JUMPN A,COMPL4	;CONTINUE
	JUMPE TT,COMPL5	;ALL ZEROS
	HRRZ A,(TT)
	HLLZS (TT)	;RPLACD HIGH ORDER NON-ZERO WITH NIL
COMPL6:	PUSHJ P,UNCONS	;UNCONS LEADING ZEROS
	JRST POPAJ

COMPL5:	EXCH A,(P)
	JRST COMPL6

;SIGN(TT)⊗SIGN(T) → TT
MQSIGN:	CAIN T,POSNUM
	JRST CPOPJ
;-SIGN(TT) → TT
COMPSN:	CAIN TT,POSNUM
	SKIPA TT,[NEGNUM]
	MOVEI TT,POSNUM
	POPJ P,
PAGE
;BIGNUM MULTIPLY
;BIG (A) * BIG (B) → A, SIGNS IN T,TT
BTIMES:	PUSHJ P,MQSIGN
	PUSH P,TT	;SAVE SIGN OF RESULT
	PUSHJ P,BMUL
	POP P,B
	JRST MAKBIG

;0(P) IS PARTIAL RESULT
;-1(P) IS REMAINING REVERSED MULTIPLIER
;-2(P) IS MULTIPLICAND

BMUL:	PUSH P,B
	PUSHJ P,REVERSE
	PUSH P,A
	MOVEI A,0
	PUSH P,A
BTLOOP:	SKIPN C,-1(P)
	JRST BTEND	;END OF MULTIPLIER
	JUMPE A,BTLP2	;FIRST TIME
	MOVE B,A
	PUSHJ P,FWCONS-1
	PUSHJ P,CONS	;INCREASE LENGTH OF PRODUCT
BTLP2:	MOVEM A,(P)
	MOVE A,-2(P)
	PUSHJ P,COPY
	MOVS B,(C)	;NEXT MULTIPLIER DIGIT
	MOVE C,A
	HLRZM B,-1(P)
	MOVE B,(B)
	MOVEI A,0
	PUSHJ P,BTIME1
	MOVE C,(P)
	JUMPE C,BTLOOP	;NO ADD NEEDED ON FIRST TIME
	MOVE B,A
	MOVEI A,0
	PUSHJ P,BADD
	JRST BTLOOP

BTEND:	SUB P,[XWD 3,3]
	JRST SUPRSS

PAGE
;EXTENSIONS OF INTERPRETER ROUTINES AND TESTS

;ADDITION TO NUMVAL. NUMV4 IN LISP CHANGED TO JRST NUMVB
NUMVB:	CAIE B,POSNUM
	CAIN B,NEGNUM
	JRST NUMVD2
	MOVE A,AR1
	JRST NUMV2	;PRINT ERROR MESSAGE

NUMVD2:	POP P,C		;ADDRESS OF (PUSHJ P,NUMVAL) +1
	HLRZ C,(C)
	CAIN C,(JUMPN A,)	;ZEROP
	JRST FALSE
	CAIN C,(JUMPGE A,)	;MINUSP
	JRST MINSP2
	CAIN C,(MOVNS)		;MINUS
	JRST MINS2
	CAIN C,(MOVMS)		;ABS
	JRST ABS2
	CAIN C,(CAIE B,)	;FIX
	JRST POPAJ
	HALT			;TEMPORARY
;EXTENSION TO NUMBERP.  NUMBRP4 IN LISP CHANGED TO JRST BIGNP
BIGNP:	CAIE A,POSNUM
	CAIN A,NEGNUM
	JRST TRUE
	JRST FALSE
PAGE
;EXTENSION TO OP.  OPOV IN LISP CHANGED TO JFCL 10,FIXOVL
FIXOVL:	HLRZ C,(C)
	CAIN C,(IMUL A,)
	JRST REMUL	;TIMES OVERFLOWED. RECOMPUTE
	TLC A,SIGN	;ALL OTHER CASES JUST OVERFLOWED 1 BIT
	MOVM B,A
	MOVE TT,A
	MOVEI A,1
	PUSHJ P,MKBG
	JRST QCONS

REMUL:	MOVE A,AR1
	MOVEI B,FIXNUM
	MOVEI T,FIXNUM
	PUSHJ P,BIGTST
	JRST BTIMES	;USE THE BIGNUM MULTIPLICATION

;EXTENSION TO OP.  NUMV3 CHANGED TO JRST BIGDIS
;BIGDIS DETERMINES THE BIGNUM OPERATION TO BE PERFORMED
BIGDIS:	CAIE T,FLONUM
	CAIN B,FLONUM
	JRST FLOBIG	;OPERATION WITH FLT PT OPERAND
	PUSHJ P,BIGTST	
	HLRZ C,(C)
	CAIN C,(ADD A,)	;PLUS
	JRST BPLUS
	CAIN C,(SUB A,)	;DIF
	JRST BDIF
	CAIN C,(IMUL A,)	;TIMES
	JRST BTIMES
	CAIN C,(IDIV A,)	;QUOTIENT
	JRST BQUO
	CAIN C,(JRST)		;LESSP OR GREATERP
	JRST BCMPR
	CAIN C,(JUMPN 0,)	;DIVIDE
	JRST BDIV
	CAIN C,(JUMPA)		;GCD
	JRST GCD
	CAIN C,(JUMPL)		;EQUAL
	JRST BEQUAL
	HALT			;TEMPROARY
PAGE
;TRANSFORMS GENERAL NUMBERS IN (A,T),(TT,B)
;INTO BIGNUMS IN (A,T),(B,TT), VALUES IN A,B; SIGNS IN T,TT.
BIGTST:	EXCH B,T	;FUNNY AC USAGE IN LISP
	PUSH P,T
	PUSH P,TT
	PUSHJ P,BIGSUB	;CONVERT NUMBER ORIGINALLY IN A,T
	EXCH B,-1(P)
	EXCH A,(P)
	PUSHJ P,BIGSUB	;CONVERT NUMBER ORIGINALLY IN TT,B
	MOVE TT,B
	MOVE B,A
	POP P,A
	POP P,T
	POPJ P,

BIGSUB:	CAIE B,POSNUM
	CAIN B,NEGNUM
	POPJ P,		;NO CONVERSION NECESSARY
	CAIE B,FIXNUM
	JRST NUMV2	;CHECK FOR FLONUM
	MOVEI B,0
	MOVE TT,A	;GET VALUE OF NUMBER
	MOVM A,TT
	JUMPGE A,BIGSRT	
	MOVEI A,1	;BASTARD CASE OF -2↑35
MKBG:	PUSHJ P,MKBIG
	JRST BIGSND

BIGSRT:	PUSHJ P,BCONS
BIGSND:	SKIPGE TT
	SKIPA B,[NEGNUM]
	MOVEI B,POSNUM
	POPJ P,

MKBIG:	PUSH P,B
	PUSHJ P,BNCONS
	MOVE B,A
	POP P,A
	JRST BCONS
PAGE
;MAKE A LISP NUMBER FROM BIGNUM -- A IS LIST, B IS SIGN
MAKBIG:	JUMPE A,FIX1A	;NULL LIST PRODUCES ZERO
	HRRZ C,(A)
	JUMPN C,QCONS		;A REAL BIGNUM
	HLRZ C,(A)		;ONLY ONE WORD OF PRECISION
	MOVE C,(C)
	CAIE B,POSNUM
	MOVNS C			;NEGATIVE 
	PUSHJ P,UNCONS
	MOVE A,C
	JRST FIX1A
PAGE
FLOBIG:	CAIE T,FLONUM
	JRST FLBG2
	MOVE A,(A)
	EXCH A,TT
	EXCH B,T
	PUSHJ P,BFLT
	EXCH A,TT
	JRST OPR

FLBG2:	PUSHJ P,BFLT
	MOVE TT,(TT)
	JRST OPR

;MAKE A FLOATING PT NUMBER OUT OF A BIGNUM
BFLT:	PUSH P,C
	PUSH P,T
	CAIE T,POSNUM
	CAIN T,NEGNUM
	SKIPA T,[-200]
	JRST NUMV2
BFLT2:	MOVE C,B
	HLRZ B,(A)
	HRRZ A,(A)
	ADDI T,43
	JUMPN A,BFLT2	;FIND LAST TWO WORDS OF BIGNUM
	MOVE B,(B)
	MOVE C,(C)
BFLT3:	TLNE B,SIGN/2
	JRST BFLT4
	ASHC B,1
	SOJA T,BFLT3	;NORMALIZE B,C
BFLT4:	JUMPGE T,FLOOV
	ASH B,-10
	DPB T,[POINT 8,B,8]
	MOVE A,B
	POP P,T
	POP P,C
	CAIE T,POSNUM
	MOVNS A
	POPJ P,

;MAKE A BIGNUM FROM A FLT PT NUMBER
BFIX:	MOVE A,(P)
	PUSHJ P,NUMVAL
	MOVMS A
	MULI A,400
	MOVEI C,-243(A)	;#LEFT SHIFTS NEEDED
	IDIVI C,43	;C←#EXTRA WORDS-1, D←#SHIFTS
	MOVEI A,0
	ASHC A,(C+1)
	PUSH P,B
	PUSHJ P,BNCONS
	MOVE B,A
	POP P,A
	PUSHJ P,BCONS
	SOJL C,BFIX2
	MOVE B,A
	MOVEI A,0
	PUSHJ P,BCONS
	SOJGE C,.-3
BFIX2:	POP P,TT
	PUSHJ P,BIGSND
	JRST QCONS

PAGE
;BIGNUM DIVIDE
BDIV:	PUSHJ P,MQSIGN	;COMPLEMENT SIGN OF TT IF T IS NEGNUM
	PUSH P,T	;SIGN OF REMAINDER
	PUSH P,TT	;SIGN OF QUOTIENT
	PUSHJ P,DIVSUB
BDIV2:	EXCH B,(P)
	PUSHJ P,MAKBIG	;QUOTIENT
	MOVE B,-1(P)
	MOVEM A,-1(P)
	POP P,A
	PUSHJ P,MAKBIG	;REMAINDER
	POP P,B
	JRST XCONS

BQUO:	PUSHJ P,MQSIGN
	PUSH P,TT
	PUSHJ P,DIVSUB
	PUSH P,A
	MOVE A,B
	PUSHJ P,UNCONS
	POP P,A
	POP P,B
	JRST MAKBIG

DIVSUB:	HRRZ C,(B)
	JUMPN C,DIV1
;NULL(CDR B) MEANS SINGLE LENGTH DIVISOR
BQUO1:	PUSH P,B
	PUSHJ P,COPY
	POP P,B
	HLRZ B,(B)
	MOVE B,(B)
	PUSHJ P,Q1
	PUSH P,B	;QUOTIENT
	PUSHJ P,BNCONS
	MOVE B,A
	JRST POPAJ

PAGE
;DIV1 DOES LONG DIVISION OF X/Y 
;ENTER WITH X IN A, Y IN B.
DIV1:	PUSH P,A	;X
	PUSH P,B	;Y
	MOVE A,B
	PUSHJ P,HIDIG
	HRLOI A,SIGN/2-1
	IDIV A,(C)	;(BETA/2-1)/Y[N-1]+1
	ADDI A,1
	MOVEM A,SCALE#
	MOVE B,A
	MOVE A,(P)	;Y - DIVISOR
	PUSHJ P,BTIME0	;SCALE*Y
	MOVEM A,V	;SCALED DIVISOR
	MOVEM A,(P)	;PROTECT V FROM GC
	PUSHJ P,HIDIG
	POP C,VH	;V[N-1]
	POP C,VH1	;V[N-2]
	MOVE A,-1(P)	;X - NUMERATOR
	PUSHJ P,COPY
	PUSHJ P,EXTND
	MOVE B,SCALE
	MOVE C,A
	PUSHJ P,BTIME1-1	;SCALE*X  -- SCALED NUMERATOR
	MOVEM A,-1(P)	;U
	PUSH P,[NIL]	
	HRRZM P,QUO#	;POINTER TO QUOTIENT LIST
	PUSHJ P,LENGTH
	PUSH P,A
	MOVE A,V#
	PUSHJ P,LENGTH
	POP P,B
	SUB B,A		;LENGTH(U)-LENGTH(V)
	MOVE A,-2(P)	;U
	JUMPLE B,DIV1X	;SPECIAL CASE OF U<V
	PUSHJ P,DIV2	;CARRY OUT DIVISION WITH PARAMETERS
DIV1X:	PUSHJ P,SUPRSS	;SUPPRESS LEADING ZEROS OF REMAINDER
	JUMPE A,DIV1Y	;ZERO REMAINDER
	MOVE B,SCALE
	PUSHJ P,Q1	;U/SCALE - FINAL REMAINDER IN B
	MOVE A,B
DIV1Y:	EXCH A,(P)
	PUSHJ P,SUPRSS	;SUPPRESS LEADING ZEROS IN QUOTIENT
	POP P,B
	SUB P,[XWD 2,2]
	POPJ P,

;RECURSIVE FUNCTION TO POSITION V PROPERLY WITH RESPECT TO U.
; ON SUCCESSIVE CALLS TO DIV3 WHICH CALCULATES QUOTIENT DIGITS.
;ENTER DIV2 WITH U IN A, N IN B. N= LENGTH(U)-LENGTH(V)-1.

DIV2:	SOJLE B,DIV3
	PUSH P,A	;U
	HRRZ A,(A)
	PUSHJ P,DIV2
	HRRM A,@(P)	;(RPLACD U,(DIV3(CDR U)))
	POP P,A
	JRST DIV3
PAGE
;ENTER WITH U[J] IN A

DIV3:	PUSH P,A	;UJ
	PUSHJ P,HIDIG
	POP C,A		;UH
	CAML A,VH#
	JRST DIVCS1	;STRANGE CASE WHEN UH≥VH
	POP C,B		;UH1
	DIV A,VH	;(UH*BETA+UH1)/VH
	PUSH P,A	;QUOTIENT DIGIT
L1:	MOVEM B,REM#	;REMAINDER
	MUL A,VH1#
	SUB A,REM	;(VH1*QUO)-BETA*REM
	CAMGE B,(C)	;UH2
	SUBI A,1
	JUMPG A,DIVCS2	;QUOTIENT TOO BIG
L4:	MOVE A,V
	MOVE B,(P)	;QUOTIENT DIGIT
	PUSHJ P,BTIME0	;Q*V
	MOVE C,-1(P)	;UJ
	MOVE B,A
	MOVEI A,0
	PUSHJ P,BSUB	;UJ-Q*V
	JUMPL B,DIVCS3	;QUOTIENT TOO BIG
L3:	MOVEM A,-1(P)	;NEW UJ
	POP P,A		;QUOTIENT DIGIT
	MOVE B,@QUO
	PUSHJ P,BCONS
	MOVEM A,@QUO	;NEW QUOTIENT LIST
	MOVE A,(P)
	PUSHJ P,DIVSRT	;SHORTEN UJ BY ONE DIGIT
	JRST POPAJ
PAGE
;SPECIAL CASE OF UH≥VH
DIVCS1:	HRLOI A,SIGN-1		;BETA-1
	PUSH P,A
	POP C,B		;UH1
	ADD B,VH	;R←UH1+VH
	JUMPL B,L4
	JRST L1

;SPECIAL CASE CORRECTION FOR QUOTIENT
DIVCS2:	SOS A,(P)		;QUOTIENT←QUOTIENT-1
	MOVE B,REM
	ADD B,VH	;R←R+VH
	JRST L1

;SPECIAL CASE OF QUOTIENT TOO LARGE
DIVCS3:	SOS (P)		;QUOTIENT←QUOTIENT-1
	PUSH P,A
	MOVE A,V
	PUSHJ P,COPY
	MOVE C,A
	POP P,B
	MOVEI A,0
	PUSHJ P,BADD	;U←U+V
	MOVEM A,-1(P)
	PUSHJ P,DIVSRT	;SHORTEN OVERFLOWED DIGIT
	JRST L3+1
PAGE
;PUSHES SUCCESSIVE DIGITS OF LIST IN A ONTO PDL
;RETURNS C POINTING TO PDL LOCATION OF LAST DIGIT
HIDIG:	MOVE C,P
	MOVS B,(A)
	PUSH P,(B)
	HLRZ A,B
	JUMPN A,HIDIG+1
	EXCH C,P
	POPJ P,

;SHORTEN LIST BY ONE
DIVSRT:	MOVE C,A
	HRRZ A,(A)
	HRRZ B,(A)	;CDDR
	JUMPN B,.-3
	HLLZS (C)	;NULL (CDDR C) => RPLACD(C NIL)
	HLRZ B,(A)
	JRST UNCONS

;LENGTHEN LIST BY ONE
EXTND:	PUSH P,A
	PUSHJ P,LAST
	MOVE T,A
	PUSHJ P,B0CONS
	HRRM A,(T)
	JRST POPAJ
PAGE
GA==4
GB==5
GC==6
GD==7
UP==10
VP==11
Q==12
;BIGNUM GCD
GCD:	PUSH P,B
	PUSHJ P,COPY
	EXCH A,(P)	;V
	PUSHJ P,COPY
	PUSH P,A	;U
	PUSHJ P,COPY
	MOVE C,A
	MOVE A,-1(P)	
	PUSHJ P,COPY
	MOVE B,A	;U
	MOVEI A,0
	PUSHJ P,BSUB	;V-U
	PUSH P,B
	PUSHJ P,BSUBND
	JUMPE A,GCDSC1	;U=V
	PUSHJ P,UNCONS
	POP P,B
	JUMPGE B,GCD2	;U≥V
	MOVE A,(P)
	EXCH A,-1(P)
	MOVEM A,(P)
PAGE
;NOW V<U   V IN -1(P), U IN (P)
GCD2:	MOVE A,-1(P)
	JUMPE A,GCDEND	;V IS ZERO
	HRRZ B,(A)
	JUMPE B,GCDSING	;V IS SINGLE PRECISION
	PUSHJ P,LENGTH	;LENGTH (V)
	MOVE T,A
	MOVE A,(P)	;U
	PUSHJ P,LENGTH
	SUB A,T		;L(U)-L(V)
	JUMPE A,GCD4
	SOJN A,GCD7A	;>1
	MOVE A,-1(P)	;V
	PUSHJ P,EXTND	;LENGTHEN V BY ONE HIGH ORDER ZERO
GCD4:	MOVE A,(P)	;U
	PUSHJ P,HIDIG
	HRLOI A,SIGN/2-1	;BETA/2-1
	IDIV A,(C)	;(BETA/2-1)/U[N-1]+1
	ADDI A,1
	MOVEM A,SCALE
	PUSHJ P,GCSB
	MOVE UP,A	;SCALE*UH
	MOVE A,-1(P)	;V
	PUSHJ P,HIDIG
	PUSHJ P,GCSB
	MOVE VP,A	;SCALE*VH
	MOVEI GA,1
	MOVEI GD,1
	SETZB GC,GB
PAGE
GCD5:	MOVE A,UP
	ADD A,GA
	MOVE B,VP
	ADD B,GC
	JUMPE B,GCD7
	JUMPL A,GCD5X	;OVERFLOW CASE
	IDIV A,B	;(U'+A)/(V'+C)
GCD5A:	MOVE Q,A
	MOVE A,UP
	ADD A,GB
	MOVE B,VP
	ADD B,GD
	JUMPE B,GCD7
	SKIPG B
	TDZA A,A	;SPECIAL CASE OF V'+D = BETA
	IDIV A,B	;(U'+B)/(V'+D)
	CAME A,Q
	JRST GCD7
	MOVE A,GC
	EXCH GA,GC	;A'←C
	IMUL A,Q
	SUB GC,A	;C'←A-Q*C
	MOVE A,GD
	EXCH GB,GD	;B'←D
	IMUL A,Q	
	SUB GD,A	;D'←B-Q*D
	MOVE A,VP
	EXCH UP,VP	;UP'←VP
	IMUL A,Q
	SUB VP,A	;VP'←UP-Q*VP
	JRST GCD5
PAGE
;SPECIAL CASE WHEN U'+A=BETA
GCD5X:	MOVEI A,1
	MOVE C,B
	MOVEI B,0
	DIV A,C
	JRST GCD5A

GCD7:	JUMPE GB,GCD7A
	MOVE A,(P)	;U
	MOVE B,-1(P)	;V
	PUSH P,GC
	PUSH P,GD
	PUSHJ P,GCDSB	;A*U+B*V
	POP P,GB
	POP P,GA
	EXCH A,(P)	;U
	MOVE B,-1(P)
	PUSHJ P,GCDSB	;C*U+D*V
	MOVEM A,-1(P)	;V
	JRST GCD2

GCDSB:	PUSH P,GA
	PUSH P,GB
	PUSH P,B
	MOVM B,GA
	PUSHJ P,BTIME0
	EXCH A,(P)	;B
	MOVM B,-1(P)	;GB
	PUSHJ P,BTIME0
	POP P,B	;A*GA
	POP P,GA
	POP P,GB
	XOR GA,GB
	MOVE C,A
	MOVEI A,0
	JUMPGE GA,BADD	;SIGNS SAME
	PUSHJ P,BSUB	;SIGNS DIFFERENT
BSUBND:	JUMPGE B,SUPRSS
	JRST COMPLM

GCD7A:	MOVE A,-1(P)
	PUSHJ P,SUPRSS
	MOVE B,A
	MOVE A,(P)
	PUSHJ P,DIV1	;U/V
	EXCH B,-1(P)	;V←REMAINDER
	MOVEM B,(P)	;U←V
	PUSHJ P,UNCONS	;DONT NEED QUOTIENT
	JRST GCD2
PAGE
GCDSING:	
	POP P,A	;U
	MOVE B,(P)	;V - SINGLE PRECISION
	HLRZ B,(B)
	MOVE B,(B)
	MOVEM B,(P)
	PUSHJ P,Q1	;U MOD V → A
	POP P,B		;A < B
	JUMPE A,GCDS2
;SINGLE PRECISION GCD
	IDIV B,A
	MOVE B,A
	MOVE A,C
	JUMPN A,.-3
GCDS2:	MOVE A,B
	JRST FIX1A

GCSB:	MOVE A,-1(C)
	MUL A,SCALE
	MOVE B,A
	MOVE A,(C)
	IMUL A,SCALE
	ADD A,B
	POPJ P,
PAGE
GCDSC1:	SUB P,[XWD 2,2]
	POP P,A
	MOVEI B,POSNUM
	JRST MAKBIG

GCDEND:	POP P,A	;U IS RESULT
	SUB P,[XWD 1,1]
	MOVEI B,POSNUM
	JRST MAKBIG

	END